home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / me_cd25.zip / MUTT2.ZIP / REGISTER.MUT < prev    next >
Lisp/Scheme  |  1992-11-09  |  3KB  |  91 lines
  1. ;; register.mut
  2. ;; Implements a subset of GNU Emacs's register commands.
  3. ;; Diffs:
  4. ;;   In insert register, I use the opposite behavior for dot and mark (of
  5. ;;     GNU) to be consistant with yank.  See comments in insert-register if
  6. ;;     you want to change it back.
  7. ;; Not implemented:
  8. ;;   Saving positions in registers.
  9. ;; C Durland  8/92    Public Domain
  10.  
  11. (include me2.h)
  12.  
  13. (array small-int registers 36)
  14.  
  15. (defun 
  16.   get-register-num (string prompt) HIDDEN
  17.   {
  18.     (int n)
  19.  
  20.     (n { (msg prompt " (0-9, a-z): ")(get-key) })
  21.     (if (== n 0x147) (abort))    ;; ^G
  22.     (if (not (or        ;; !((0 <= x <= 9) || (a <= x <= z))
  23.       (and (<= 0x30 n) (<= n 0x39))        ;; 0-9
  24.       (and (<= 0x61 n) (<= n 0x7A))))    ;; a-z
  25.       { (msg "Out of bounds (0-9, a-z)!")(halt) })
  26.  
  27.     ;; convert key to 0 - 35
  28.     ;; '0' - '9' => 0-9, 'a'-'z' => 10-35
  29.     (if (<= n 0x39) (- n 0x30) (- n 0x57))
  30.   }
  31.     ;; Insert the contents of a register at the dot.
  32.     ;; Normally, the dot is left before the register text, the mark after
  33.     ;;   (oppsite of yank).  With arg, behaves like yank.
  34.     ;;   Uggg.  I can't stand it - for consistancy, I going with the way
  35.     ;;   yank works.  You can change it back by easily (uncomment some
  36.     ;;   lines and comment one).
  37.   insert-register
  38.   {
  39. ;    (byte type)(small-int width height)(int size)    ;; struct BagInfo
  40.     (int n)
  41.  
  42.     (n (get-register-num "Insert register"))
  43.     (if (== 0 (n (registers n))) { (msg "Nothing in register!")(done) })
  44.  
  45.     (set-mark THE-MARK)
  46.     (insert-bag n)
  47.  
  48. ;    (bag-stats n (loc type))
  49.  
  50.     ;; GNU Emacs like behaivor:
  51.     ;; if rectangle:   need-to-swap-marks == arg-flag
  52.     ;; if !rectangle:  need-to-swap-marks == !arg-flag
  53. ;    (if (if (== type BAG-IS-RECTANGLE) (arg-flag) (not (arg-flag)))
  54. ;    (swap-marks THE-DOT THE-MARK))
  55.  
  56.         ;; yank like:
  57.     (if (arg-flag) (swap-marks THE-DOT THE-MARK))
  58.   }
  59.   copy-to-register
  60.   {
  61.     (int n bag)
  62.  
  63.     (n (get-register-num "Copy to register"))
  64.     (if (== 0 (registers n)) (registers n (create-bag TRUE)) )
  65.     (bag (registers n))
  66.  
  67.     (clear-bag bag)(append-to-bag bag APPEND-REGION)
  68.  
  69.     (if (arg-flag) (delete-region))
  70.   }
  71.   copy-region-to-rectangle
  72.   {
  73.     (int n bag)
  74.  
  75.     (n (get-register-num "Copy rectangle to register"))
  76.     (if (== 0 (registers n)) (registers n (create-bag TRUE)) )
  77.     (bag (registers n))
  78.  
  79.     (clear-bag bag)(append-to-bag bag APPEND-RECTANGLE)
  80.  
  81.     (if (arg-flag) (erase-rectangle TRUE))
  82.   }
  83. )
  84.  
  85. (defun MAIN
  86. {
  87.   (bind-to-key "copy-to-register"        "C-xx")
  88.   (bind-to-key "copy-region-to-rectangle"    "C-xr")
  89.   (bind-to-key "insert-register"        "C-xg")
  90. })
  91.